home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d18 / opbonus.arc / WFIELD.ARC / WFIELD3.PAS < prev    next >
Pascal/Delphi Source File  |  1991-03-20  |  10KB  |  332 lines
  1. {$V-}
  2.  
  3. (*
  4.    WFIELD3
  5.    -------
  6.  
  7.    This program is an example of a PickList embedded within a data entry
  8.    screen. Points worth noting:
  9.  
  10.      1) The post-edit routine manages the interaction between the State
  11.         field (a string) and the StateWin field (a pick list). As long as the
  12.         string field is empty, the contents of the pick list are suppressed
  13.         when the pick list is inactive. (Notice that ResetScreen must be
  14.         called to redraw the entire window; otherwise only the frame for the
  15.         pick list will be redrawn.) If the user presses <Enter> (ccSelect)
  16.         while within the pick list, the abbreviation for the selected state is
  17.         stored in the string field.
  18.  
  19.      2) The StateChoice routine does one of three things: 1) if the pick list
  20.         is inactive and no choice has been made previously, it returns an
  21.         empty string; 2) if the Mode is pkSearch, it returns the abbreviation
  22.         for the state--this is what gets stored in the string field; or 3) if
  23.         the Mode is not pkSearch, it returns the complete name of the
  24.         state--this is what gets displayed in the pick list.
  25.  
  26.      3) The PickList's SetSearchMode method enables character-based searching
  27.         within the pick list. (Try pressing 'N' repeatedly, for example.)
  28.  
  29.      4) By activating the sefSwitchCommands option before calling
  30.         AddWindowField, we tell OPENTRY to make the PickList use the same
  31.         CommandProcessor as the EntryScreen. This allows commands such as
  32.         ccTab, which normally have no meaning in a PickList, to produce the
  33.         same effects that they have when issued within the EntryScreen itself.
  34.  
  35.      5) Notice how the wAltFrame option lets us "highlight" the PickList when
  36.         it becomes active: the active frame has special headers; the inactive
  37.         frame does not.
  38.  
  39.      6) The wNoCoversBuffer option is used for the PickList field to limit
  40.         memory usage.
  41.  
  42. *)
  43.  
  44. program WFIELD3;
  45.  
  46. {$I OPDEFINE.INC}
  47.  
  48. uses
  49.   Dos,
  50.   OpInline,
  51.   OpString,
  52.   OpRoot,
  53.   OpCrt,
  54.   {$IFDEF UseMouse}
  55.   OpMouse,
  56.   {$ENDIF}
  57.   OpAbsFld,
  58.   OpCmd,
  59.   OpField,
  60.   OpFrame,
  61.   OpWindow,
  62.   OpPick,
  63.   OpSelect,
  64.   OpEntry;
  65.  
  66.   {$IFDEF UseMouse}
  67. const
  68.   MouseChar  : Char = #04;
  69.   {$ENDIF}
  70.  
  71. {Color set used by entry screen}
  72. const
  73.   EsColors : ColorSet = (
  74.     TextColor       : $1E; TextMono        : $0F;
  75.     CtrlColor       : $1E; CtrlMono        : $0F;
  76.     FrameColor      : $1F; FrameMono       : $0F;
  77.     HeaderColor     : $1F; HeaderMono      : $0F;
  78.     ShadowColor     : $09; ShadowMono      : $0F;
  79.     HighlightColor  : $4F; HighlightMono   : $70;
  80.     PromptColor     : $1B; PromptMono      : $07;
  81.     SelPromptColor  : $1B; SelPromptMono   : $07;
  82.     ProPromptColor  : $1B; ProPromptMono   : $07;
  83.     FieldColor      : $1E; FieldMono       : $0F;
  84.     SelFieldColor   : $3E; SelFieldMono    : $70;
  85.     ProFieldColor   : $1F; ProFieldMono    : $07;
  86.     ScrollBarColor  : $13; ScrollBarMono   : $07;
  87.     SliderColor     : $13; SliderMono      : $0F;
  88.     HotSpotColor    : $30; HotSpotMono     : $70;
  89.     BlockColor      : $3E; BlockMono       : $0F;
  90.     MarkerColor     : $3F; MarkerMono      : $70;
  91.     DelimColor      : $1E; DelimMono       : $0F;
  92.     SelDelimColor   : $31; SelDelimMono    : $0F;
  93.     ProDelimColor   : $1E; ProDelimMono    : $0F;
  94.     SelItemColor    : $3E; SelItemMono     : $70;
  95.     ProItemColor    : $17; ProItemMono     : $07;
  96.     HighItemColor   : $1F; HighItemMono    : $0F;
  97.     AltItemColor    : $1F; AltItemMono     : $0F;
  98.     AltSelItemColor : $3F; AltSelItemMono  : $70;
  99.     FlexAHelpColor  : $1F; FlexAHelpMono   : $0F;
  100.     FlexBHelpColor  : $1F; FlexBHelpMono   : $0F;
  101.     FlexCHelpColor  : $1B; FlexCHelpMono   : $70;
  102.     UnselXrefColor  : $1E; UnselXrefMono   : $09;
  103.     SelXrefColor    : $3F; SelXrefMono     : $70;
  104.     MouseColor      : $4F; MouseMono       : $70
  105.   );
  106.  
  107. {Entry field constants}
  108. const
  109.   idName                 = 0;
  110.   idAddress              = idName + 1;
  111.   idCity                 = idAddress + 1;
  112.   idStateWin             = idCity + 1;
  113.   idState                = idStateWin + 1;
  114.   idZipCode              = idState + 1;
  115.   idPhone                = idZipCode + 1;
  116.  
  117. type
  118.   UserRecord =
  119.     record
  120.       Name                 : string[25];
  121.       Address              : string[25];
  122.       City                 : string[25];
  123.       State                : string[2];
  124.       ZipCode              : string[10];
  125.       Phone                : string[14];
  126.     end;
  127. var
  128.   ES     : EntryScreen;
  129.   PL     : PickList;
  130.   UR     : UserRecord;
  131.   Status : Word;
  132.  
  133. const
  134.   StateStrings : array[1..51] of string[19] = (
  135.     {01} 'AK Alaska',         {02} 'AL Alabama',          {03} 'AR Arkansas',
  136.     {04} 'AZ Arizona',        {05} 'CA California',       {06} 'CO Colorado',
  137.     {07} 'CT Connecticut',    {08} 'DC Dist of Columbia', {09} 'DE Delaware',
  138.     {10} 'FL Florida',        {11} 'GA Georgia',          {12} 'HI Hawaii',
  139.     {13} 'IA Iowa',           {14} 'ID Idaho',            {15} 'IL Illinois',
  140.     {16} 'IN Indiana',        {17} 'KS Kansas',           {18} 'KY Kentucky',
  141.     {19} 'LA Louisana',       {20} 'MA Massachusetts',    {21} 'MD Maryland',
  142.     {22} 'ME Maine',          {23} 'MI Michigan',         {24} 'MN Minnesota',
  143.     {25} 'MO Missouri',       {26} 'MS Mississippi',      {27} 'MT Montana',
  144.     {28} 'NC North Carolina', {29} 'ND North Dakota',     {30} 'NE Nebraska',
  145.     {31} 'NH New Hampshire',  {32} 'NJ New Jersey',       {33} 'NM New Mexico',
  146.     {34} 'NV Nevada',         {35} 'NY New York',         {36} 'OH Ohio',
  147.     {37} 'OK Oklahoma',       {38} 'OR Oregon',           {39} 'PA Pennsylvania',
  148.     {40} 'RI Rhode Island',   {41} 'SC South Carolina',   {42} 'SD South Dakota',
  149.     {43} 'TN Tennessee',      {44} 'TX Texas',            {45} 'UT Utah',
  150.     {46} 'VA Virginia',       {47} 'VT Vermont',          {48} 'WA Washington',
  151.     {49} 'WI Wisconsin',      {50} 'WV West Virginia',    {51} 'WY Wyoming');
  152.  
  153. {$F+}
  154. procedure StateChoice(Item : Word; Mode : pkMode;
  155.                       var IType : pkItemType;
  156.                       var IString : string;
  157.                       PickPtr : PickListPtr);
  158.   {-Return a state string given an index}
  159. begin
  160.   {blank out pick list if no choice has been made and pick list is inactive}
  161.   if (UR.State = '') and (ES.ActiveChild <> Pointer(PickPtr)) then
  162.     IString := ''
  163.   else if (Mode = pkSearch) then begin
  164.     {return only the first two characters -- the abbreviation}
  165.     IString := StateStrings[Item];
  166.     IString[0] := #2;
  167.   end
  168.   else
  169.     {return the full name and ignore the abbreviation}
  170.     IString := Copy(StateStrings[Item], 3, 255);
  171. end;
  172.  
  173. procedure PostEdit(ESP : EntryScreenPtr);
  174.   {-Called just after a field has been edited}
  175. begin
  176.   with ESP^ do
  177.     if (GetCurrentID = idStateWin) then
  178.       if (GetLastCommand = ccSelect) then begin
  179.         {store the user's choice}
  180.         UR.State := Trim(StateStrings[PL.GetLastChoice]);
  181.         DrawField(idState);
  182.       end
  183.       {blank out the pick list if no selection has been made}
  184.       else if (UR.State = '') then
  185.         ResetScreen;
  186. end;
  187. {$F-}
  188.  
  189. function InitEntryScreen : Word;
  190.   {-Initialize entry screen generated by MAKESCRN}
  191. const
  192.   WinOptions = wBordered+wClear+wUserContents;
  193. begin
  194.   with ES do begin
  195.     if not InitCustom(20, 9, 59, 16, EsColors, WinOptions) then begin
  196.       InitEntryScreen := InitStatus;
  197.       Exit;
  198.     end;
  199.  
  200.     wFrame.SetFrameType(SglWindowFrame);
  201.     wFrame.AddShadow(shBR, shOverWrite);
  202.     SetWrapMode(WrapAtEdges);
  203.  
  204.     SetPostEditProc(PostEdit);
  205.  
  206.   {idName:}
  207.     AddStringField(
  208.       'Name', 1, 7,
  209.       CharStr('X', 25), 1, 13, 25,
  210.       1, UR.Name);
  211.  
  212.   {idAddress:}
  213.     AddStringField(
  214.       'Address', 2, 4,
  215.       CharStr('X', 25), 2, 13, 25,
  216.       2, UR.Address);
  217.  
  218.   {idCity:}
  219.     AddStringField(
  220.       'City', 3, 7,
  221.       CharStr('X', 25), 3, 13, 25,
  222.       3, UR.City);
  223.  
  224.   {idStateWin:}
  225.     esSecFieldOptionsOn(sefSwitchCommands);
  226.     AddWindowField(
  227.       '', 4, 17,
  228.       4, 17,
  229.       4, PL);
  230.     esSecFieldOptionsOff(sefSwitchCommands);
  231.  
  232.   {idState:}
  233.     esFieldOptionsOn(efProtected);
  234.     AddStringField(
  235.       'State', 5, 6,
  236.       'XX', 5, 13, 2,
  237.       5, UR.State);
  238.     esFieldOptionsOff(efProtected);
  239.  
  240.   {idZipCode:}
  241.     AddStringField(
  242.       'Zip', 7, 8,
  243.       '99999-9999', 7, 13, 10,
  244.       6, UR.ZipCode);
  245.  
  246.   {idPhone:}
  247.     AddStringField(
  248.       'Phone', 8, 6,
  249.       '(999) 999-9999', 8, 13, 14,
  250.       7, UR.Phone);
  251.  
  252.     InitEntryScreen := RawError;
  253.   end;
  254. end;
  255.  
  256. function InitPickList : Word;
  257.   {-Initialize the pick list}
  258. const
  259.   WinOptions = wBordered+wAltFrame+wClear+wUserContents+wNoCoversBuffer;
  260. begin
  261.   with PL do begin
  262.     if not InitCustom(
  263.       36, 13, 53, 13, EsColors, WinOptions, 18, 51,
  264.       StateChoice, PickVertical, SingleChoice) then begin
  265.         InitPickList := InitStatus;
  266.         Exit;
  267.       end;
  268.  
  269.     pkOptionsOff(pkDrawActive);
  270.     SetSearchMode(PickCharSearch);
  271.  
  272.     wFrame.SetFrameType(DblWindowFrame);
  273.  
  274.     AddMoreHeader(' || ', heBR, #24, #25, '', 2, 3, 0);
  275.  
  276.     aFrame.SetFrameType(SglWindowFrame);
  277.  
  278.     InitPickList := RawError;
  279.   end;
  280. end;
  281.  
  282. begin
  283.   ClrScr;
  284.  
  285.   {$IFDEF UseMouse}
  286.   if MouseInstalled then
  287.     with EsColors do begin
  288.       {activate mouse cursor}
  289.       SoftMouseCursor($0000, (ColorMono(MouseColor, MouseMono) shl 8)+
  290.                              Byte(MouseChar));
  291.       ShowMouse;
  292.       {enable mouse support}
  293.       EntryCommands.cpOptionsOn(cpEnableMouse);
  294.       PickCommands.cpOptionsOn(cpEnableMouse);
  295.     end;
  296.   {$ENDIF}
  297.  
  298.   {initialize pick list}
  299.   Status := InitPickList;
  300.   if Status <> 0 then begin
  301.     WriteLn('Error initializing pick list: ', Status);
  302.     Halt(1);
  303.   end;
  304.  
  305.   {initialize entry screen}
  306.   Status := InitEntryScreen;
  307.   if Status <> 0 then begin
  308.     WriteLn('Error initializing entry screen: ', Status);
  309.     Halt(1);
  310.   end;
  311.  
  312.   {initialize user record}
  313.   FillChar(UR, SizeOf(UR), 0);
  314.  
  315.   {test entry screen}
  316.   ES.Process;
  317.  
  318.   {$IFDEF UseMouse}
  319.   HideMouse;
  320.   {$ENDIF}
  321.  
  322.   {erase the window}
  323.   ES.Erase;
  324.  
  325.   {show exit command}
  326.   ClrScr;
  327.   WriteLn('Exit command = ', ES.GetLastCommand);
  328.  
  329.   {dispose of the parent *and* its children}
  330.   ES.Done;
  331. end.
  332.